home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Games Collection 1 / software vault.zip / software vault / CDR10 / SPX20.ZIP / SPX_DEMO.ZIP / DEMO04.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-24  |  3KB  |  128 lines
  1. Program Demo4;
  2.  
  3. { SPX library - GeoMorph demo Copyright 1993 Scott D. Ramsay  }
  4.  
  5. Uses crt,spx_vga,spx_key,spx_geo,spx_txt,spx_fnc;
  6.  
  7. const
  8.   path  = '';
  9.   gmx   = 50;                    { tile map size }
  10.   gmy   = 50;
  11.   gsx   = 16;                    { tile size }
  12.   gsy   = 16;
  13.   smx   = gmx*gsx;               { tile map size in pixels }
  14.   smy   = gmy*gsy;
  15.   speed : integer = 4;
  16.  
  17. type
  18.   PMyMorph = ^TMyMorph;
  19.   TMyMorph = object(TMorph)
  20.                function geomap(x,y:integer):integer;virtual;
  21.                procedure placegeo(x,y,geonum:integer);virtual;
  22.                procedure nogogeo(x,y:integer); virtual;
  23.              end;
  24.  
  25. var
  26.   MyMorph : PMyMorph;
  27.   gpic    : array[0..20] of pointer;
  28.   map     : array[0..gmy-1,0..gmx-1] of byte;
  29.   pal     : RGBlist;
  30.   flip,
  31.   geo_cnt,
  32.   x,y     : integer;
  33.  
  34. procedure setup;
  35. begin
  36.   openmode(2);
  37.   MyMorph := new(PMyMorph,init(gmx,gmy,21,14,0,0));
  38.   setpageactive(2);
  39.   geo_cnt := loadgmp(path+'demo.gmp',gpic,map);
  40.   loadcolors(path+'demo.pal',pal,256);
  41.   fsetcolors(pal);
  42.   x := 50; y := 50;
  43. end;
  44.  
  45.  
  46. procedure changexy;
  47. begin
  48.   if np[7,2] or np[8,2] or np[9,2]
  49.     then dec(y,speed)
  50.     else
  51.       if np[1,2] or np[2,2] or np[3,2]
  52.         then inc(y,speed);
  53.   if np[7,2] or np[4,2] or np[1,2]
  54.     then dec(x,speed)
  55.     else
  56.       if np[9,2] or np[6,2] or np[3,2]
  57.         then inc(x,speed);
  58.   if ch in ['1'..'9']
  59.     then speed := vl(ch);
  60.   ifix(x,0,smx-1); ifix(y,0,smy-1);
  61. end;
  62.  
  63.  
  64. procedure Animate;
  65. begin
  66.   flip := 0;
  67.   repeat
  68.      flip := (flip+1)mod 4;
  69.      changexy;
  70.      MyMorph^.drawmap(x,y);
  71.      putletter(25,20,5,st(x)+','+st(y));
  72.      putletter(24,19,255,st(x)+','+st(y));
  73.      putletter(25,27,5,'Speed = '+st(speed));
  74.      putletter(24,26,255,'Speed = '+st(speed));
  75.      pset(160,100,255);
  76.      pset(161,101,5);
  77.      pcopy(2,1);
  78.   until esc;
  79. end;
  80.  
  81. (**) { TMyMorph methods }
  82.  
  83. function TMyMorph.geomap(x,y:integer):integer;
  84. begin
  85.   geomap := map[y,x];
  86. end;
  87.  
  88.  
  89. procedure TMyMorph.nogogeo(x,y:integer);
  90. begin
  91.   fput_clip(x,y,gpic[0]^,false);
  92. end;
  93.  
  94.  
  95. procedure TMyMorph.placegeo(x,y,geonum:integer);
  96. begin
  97.   if geonum in [1..geo_cnt]
  98.     then
  99.       if geonum=2
  100.         then fput_clip(x,y,gpic[1+flip]^,false)
  101.         else fput_clip(x,y,gpic[geonum-1]^,false);
  102. end;
  103.  
  104.  
  105. procedure showit;
  106. begin
  107.   clrscr;
  108.   writeln('SPX library - GeoMorph demo');
  109.   writeln('Copyright 1993 Scott D. Ramsay');
  110.   writeln;
  111.   writeln('Keys:');
  112.   writeln(' ESC          - quit demo');
  113.   writeln(' Arrow keys   - scroll');
  114.   writeln(' 0..9         - change speed');
  115.   writeln;
  116.   write('Press SPACE to continue.');
  117.   clearbuffer;
  118.   repeat until space;
  119. end;
  120.  
  121.  
  122. begin
  123.   showit;
  124.   setup;
  125.   Animate;
  126.   dispose(MyMorph,done);
  127.   closemode;
  128. end.